home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr51 / dbview.zip / DBVIEW.PAS < prev   
Pascal/Delphi Source File  |  1993-04-01  |  5KB  |  239 lines
  1. Program Read_DBF;
  2.  
  3. Uses Crt,Dos,Inputs,Screens;
  4.  
  5.    Const  Max_Fields = 128;
  6.           Max_Header = 4129;
  7.  
  8. Type
  9.  
  10.   String64 = String[64];
  11.   String8  = String[08];
  12.  
  13.   Field_Rec = Record
  14.     Name : String[10];
  15.     Typ  : Char;
  16.     Len  : Byte;
  17.     Dec  : Byte;
  18.     Off  : Integer;
  19.   END;
  20.  
  21.   Field_Array   = Array [1..Max_Fields] of Field_Rec;
  22.  
  23.   Header = Object
  24.     Dbase_File      : File of Byte;
  25.     Dbase_File_Name : String64;
  26.     Last_Update     : String8;
  27.     Recs            : Longint;
  28.     Header_length   : Integer;
  29.     Record_Length   : Integer;
  30.     Num_Fields      : Integer;
  31.     Fields          : Field_array;
  32.     Procedure Init (F_Name:String64);
  33.     Function  File_Exists:Boolean;
  34.     Procedure Display;
  35.     Procedure Done;
  36.   End;
  37.  
  38. Function Header.File_Exists;
  39. Var  File_Info :SearchRec;
  40. Begin
  41.   If Pos('.',Dbase_File_Name)=0 Then
  42.      Dbase_File_Name:=Dbase_File_Name+'.DBF';
  43.   FindFirst(Dbase_File_Name,Archive,File_Info);
  44.     File_Exists :=DosError=0
  45. End;
  46.  
  47. Procedure Header.Init(F_Name:String64);
  48. Var B          : Byte;
  49.     Loop       : Integer;
  50.  
  51.    Procedure Date;
  52.    Begin
  53.      Last_Update:='';
  54.      Seek(Dbase_File,3);
  55.      Read(Dbase_File,B);
  56.      Last_Update:=Chr(b);
  57.      Seek(Dbase_File,2);
  58.      Read(Dbase_File,B);
  59.      Last_Update:=Last_Update+Chr(B);
  60.      Seek(Dbase_File,1);
  61.      Read(Dbase_File,B);
  62.      Last_Update:=Last_Update+Chr(b);
  63.    End;
  64.  
  65.    Procedure Rec_In_File;
  66.    Begin
  67.      Seek(Dbase_File,4);
  68.      Read(Dbase_File,B);
  69.      Recs:= B;
  70.      Read(Dbase_File,B);
  71.      Recs:= Recs+(B*256);
  72.      Read(Dbase_File,B);
  73.      Recs:= Recs+(B*65536);
  74.      Read(Dbase_File,B);
  75.      Recs:= Recs+(B*16777216);
  76.    End;
  77.  
  78.    Procedure Len_Of_Rec;
  79.    Begin
  80.      Seek(Dbase_File,10);
  81.      Read(Dbase_File,B);
  82.        Record_Length := B;
  83.        Record_Length := Record_Length +(B*256);
  84.    End;
  85.  
  86.    Procedure Get_Fields;
  87.    Var Loop :Byte;
  88.        Count:Integer;
  89.        Blank  :Field_Rec;
  90.    Begin
  91.      Count:=32;
  92.      For Loop:=1 to  Num_Fields Do
  93.      Begin
  94.        Seek(Dbase_File,Count);
  95.        B:=1;
  96.        Blank.Name:='';
  97.        Blank.Typ :=' ';
  98.        Blank.len :=0;
  99.        Blank.Dec :=0;
  100.        Blank.Off :=0;
  101.        Fields[Loop]:=Blank;
  102.        While B <> 0 Do
  103.        Begin
  104.          Read(Dbase_File,B);
  105.          If B<>0 Then
  106.             Fields[Loop].Name:=Fields[Loop].Name+Chr(B);
  107.        End;
  108.        Inc(Count,11);
  109.        Seek(Dbase_File,Count);
  110.        Read(Dbase_File,B);
  111.        Fields[Loop].Typ:=Chr(B);
  112.        Read(Dbase_File,B);
  113.          Fields[Loop].Off:=B;
  114.        Read(Dbase_File,B);
  115.          Fields[Loop].Off:=Fields[Loop].Off+(B*256);
  116.        Read(Dbase_File,B);
  117.          Fields[Loop].Off:=Fields[Loop].Off+(B*65536);
  118.        Read(Dbase_File,B);
  119.          Fields[Loop].Off:=Fields[Loop].Off+(B*16777216);
  120.        Read(Dbase_File,B);
  121.          Fields[Loop].Len:=B;
  122.        Read(Dbase_File,B);
  123.          Fields[Loop].Dec:=b;
  124.        Inc(Count,21);
  125.      End;
  126.    End;
  127.  
  128. Begin
  129.   Dbase_File_Name:=F_name;
  130.   If Not File_Exists Then
  131.   Begin
  132.     Writeln('File Not Found ',Dbase_File_Name);
  133.     Halt;
  134.   End;
  135.  
  136.   Assign(Dbase_File,Dbase_File_Name);
  137.   Reset(Dbase_File);
  138.   Read(Dbase_File,B);
  139.   If (B<>3) And (B<>131) Then
  140.      Begin
  141.        Writeln('Not a Dbase Compatible Database File ');
  142.        Halt;
  143.      End;
  144.   b:=1;
  145.   Loop:=0;
  146.  
  147.   While B<> 13 Do
  148.   Begin
  149.     Seek(Dbase_File,Loop);
  150.     Read(dbase_File,B);
  151.     Inc(Loop);
  152.   End;
  153.  
  154.   Header_Length:=Loop+1;
  155.   Num_Fields:=(Header_Length-32) DIV 32;
  156.   Date;
  157.   Rec_In_File;
  158.   Len_Of_Rec;
  159.   Num_Fields:=(Header_Length-32) DIV 32;
  160.   Get_Fields;
  161. End;
  162.  
  163.  
  164. Procedure Header.Display;
  165. Var Loop :Byte;
  166.     Total:Integer;
  167. Begin
  168.   Writeln(' ');
  169.   Writeln('Structure of database  : ',Dbase_File_Name);
  170.   Writeln('Number of data records : ',Recs);
  171.   Writeln('Date of last Update    : ',Ord(Last_Update[1]),'/',
  172.                                       Ord(Last_Update[2]),'/',
  173.                                       Ord(Last_Update[3]));
  174.   Writeln;
  175.   Writeln('Field Name       Type        Width   Dec');
  176.   Total:=0;
  177.   For Loop:= 1 To Num_fields Do
  178.   Begin
  179.     Inc(Total,Fields[Loop].Len);
  180.     Write(Fields[Loop].Name);
  181.     GotoXY(18,WhereY);
  182.     Case Fields[Loop].Typ of
  183.       'C' : Write('Character');
  184.       'L' :Write('Logical');
  185.       'N' :Write('Numeric');
  186.       'D' :Write('Date');
  187.       'M' :Write('Memo');
  188.     End;
  189.     GotoXY(30,WhereY);Write(Fields[Loop].len:5);
  190.     GotoXY(36,WhereY);
  191.     IF Fields[Loop].Dec > 0 Then
  192.           Write(Fields[Loop].Dec:5);
  193.     Writeln;
  194.   End;
  195.   Writeln('*** Total ***');
  196.   GotoXY(30,WhereY-1);Writeln(Total:5);
  197.  
  198. End;
  199.  
  200. Procedure Header.Done;
  201. Begin
  202. End;
  203.  
  204. Function Get_File:String;
  205. Var Ins  : Data_Input;
  206. Begin
  207.    Esc:=False;
  208.    Writeln;
  209.    Writeln('dbview, Dbase 3+ File Structure Viewer ');
  210.    Writeln('Copyright 1992 U.J.Sear ');
  211.    Writeln;
  212.    Writeln('Usage :- dbview << dbase file name >> ');
  213.    Write('Please Specify File Name ');
  214.    Inverse_Video;
  215.    Get_File:=Ins.Get_Word(WhereX,WhereY,'',12);
  216.    Inverse_Video;
  217.    GotoXY(1,WhereY);Writeln('                                       ');
  218.    GotoXY(1,WhereY-2);Writeln('                                      ');
  219.    GotoXY(1,WhereY-2);
  220. End;
  221.  
  222. Var H :Header;
  223.  
  224. Procedure Do_it;
  225. Begin
  226.   With H DO
  227.   Begin
  228.      IF ParamCount < 1 Then
  229.         Init(Get_File)
  230.      Else
  231.      Init(ParamStr(1));
  232.      Display;
  233.   End;
  234. End;
  235.  
  236. Begin
  237.  Do_it;
  238. End.
  239.